home *** CD-ROM | disk | FTP | other *** search
/ Amiga Plus 1995 #5 & #6 / Amiga Plus CD - 1995 - No. 5 and 6.iso / pd / programmierung / triton / amigae / tritondemo.e < prev   
Text File  |  1995-08-25  |  16KB  |  505 lines
  1. /* This is a Triton demo in AmigaE
  2.    Example code done by Frank Verheyen on 17/10/1994
  3.    Use it, and....
  4.    consider learning E, it's a great language!
  5.  
  6.    To make this source ready for compilation, you should pump it through Mac2E (by Lionel Vintenat), which is really easy:
  7.  
  8.    use the new compilation script which invokes Mac2E automatically,
  9.    OR convert it yourself with mac2e
  10. */
  11. /*------------------------ invoke Mac2EFront -------------------------------*/
  12. /* MAC2E triton */ -> this comment invokes Mac2EFront for you
  13. /*-------------------- some needed modules ---------------------------------*/
  14. OPT OSVERSION=37
  15.  
  16. MODULE 'triton','utility/tagitem'  -> needed for triton-handling
  17. MODULE 'ReqTools'                -> not needed for triton-handling, but for the filerequester in this demo
  18. MODULE 'exec/lists', 'exec/nodes', 'utility/tagitem'
  19. /*--------------------------------------------------------------------------*/
  20. DEF    llist=NIL:PTR TO mlh            -> Exec list holds listview items
  21.  
  22. /*------------------------- object definition of message -------------------*/
  23. OBJECT tr_Message
  24.     trm_Project:LONG    -> tr_Project
  25.     trm_ID
  26.     trm_Class
  27.     trm_Data
  28.     trm_Code
  29.     trm_Qualifier
  30.     trm_Seconds
  31.     trm_Micros
  32.     trm_App:LONG        -> tr_App
  33. ENDOBJECT
  34.  
  35. /*-------------------------- main() ----------------------------------------*/
  36. PROC main()
  37.     DEF    application=NIL    -> application pointer.  This will be the master of our projects (each triton-defined-window is called a project)
  38.  
  39.     NEW llist
  40.     initList(llist)        -> Init exec list to hold listview items.  Starts out empty.
  41.  
  42.     IF tritonbase:=OpenLibrary(TRITONNAME,TRITON10VERSION)
  43.         IF (application := Tr_CreateApp([TRCA_Name, 'AmigaEExample',
  44.             TRCA_LongName, 'AmigaE Demo Application',
  45.             TRCA_Version, '0.0',
  46.             TAG_DONE]))
  47.             doMainApplication(application)    -> this routine sets up everything
  48.             Tr_DeleteApp(application)
  49.           ELSE
  50.               WriteF('Could not create application\n')
  51.               CleanUp(20)
  52.              ENDIF
  53.     ELSE
  54.          WriteF('Could not open triton.library\n')
  55.          CleanUp(20)
  56.     ENDIF
  57.  
  58.     IF tritonbase THEN CloseLibrary(tritonbase)
  59. ENDPROC
  60. /*--------------------------------------------------------------------------*/
  61.  
  62. PROC doMainApplication(app)
  63.     DEF close_me=FALSE,
  64.          trmsg:PTR TO tr_Message,
  65.          project,
  66.          class,id,data,
  67.          file[240]:STRING
  68.     DEF cycleEntries
  69.  
  70.      cycleEntries := ['Entry One  ','Entry Two  ','Entry Three  ',NIL]
  71.  
  72.     IF (project:=Tr_OpenProject(app,[WindowTitle('AmigaE Triton Demo'), WindowPosition(TRWP_CENTERDISPLAY), WindowUnderscore('~'), WindowID(1),
  73.                  HorizGroupA,
  74.                    Space,
  75.                    VertGroupA,
  76.                      Space,
  77.                   HorizGroupA,
  78.                     Space,
  79.                     VertGroupAC,
  80.                          Space,
  81.                          NamedFrameBox('Cycle talks to integer-box'),
  82.                       VertGroupA,
  83.                            Space,
  84.                            HorizGroupS,
  85.                              SpaceS,
  86.                          CycleGadget(cycleEntries,0,1),
  87.                          SpaceS,
  88.                          IntegerBox(0,1,1),
  89.                             SpaceS,
  90.                            EndGroup,
  91.                            SpaceS,
  92.                          EndGroup,
  93.                       Space,
  94.                       Button('Pop up a requester',2),
  95.                       Space,
  96.                          NamedFrameBox('File'),
  97.                          VertGroupA,
  98.                            SpaceS,
  99.                         HorizGroupA,
  100.                           SpaceS,
  101.                             StringGadgetM('This filename is a dummy...',4,240),
  102.                             Space,
  103.                           GetFileButton(3),
  104.                           SpaceS,
  105.                            EndGroup,
  106.                            Space,
  107.                          EndGroup,
  108.                       Space,
  109.                          NamedFrameBox('Slider talks to integer-box'),
  110.                       VertGroupEAC,
  111.                            SpaceS,
  112.                            HorizGroup,
  113.                              SpaceS,
  114.                          SliderGadget(0,1000,10,5),
  115.                          SpaceS,
  116.                          IntegerID(0,5,4),
  117.                          SpaceS,
  118.                            EndGroup,
  119.                            SpaceS,
  120.                          EndGroup,
  121.                          Space,
  122.                          NamedFrameBox('Progress indicator in action'),
  123.                          HorizGroupA,
  124.                            Space,
  125.                            VertGroupA,
  126.                           Space,
  127.                           Button('Start the action',6),
  128.                           Space,
  129.                            EndGroup,
  130.                            Space,
  131.                          EndGroup,
  132.                          Space,
  133.                          NamedFrameBox('ListView in action'),
  134.                          HorizGroupA,
  135.                            Space,
  136.                            VertGroupA,
  137.                           Space,
  138.                           Button('Let\as have a look',7),
  139.                           Space,
  140.                            EndGroup,
  141.                            Space,
  142.                          EndGroup,
  143.                          Space,
  144.                     EndGroup,
  145.                     Space,
  146.                   EndGroup,
  147.                   Space,
  148.                    EndGroup,
  149.                    Space,
  150.                  EndGroup,
  151.             EndProject]))
  152.  
  153.         WHILE (close_me=FALSE)
  154.             Tr_Wait(app,NIL)
  155.             IF (trmsg:=Tr_GetMsg(app))
  156.                 IF (trmsg.trm_Project=project)
  157.                     class := trmsg.trm_Class
  158.                     id := trmsg.trm_ID
  159.                             ->WriteF('class= \h, id= \d, data= \d, code= \d \n',class,id,trmsg.trm_Data,trmsg.trm_Code)
  160.                     SELECT class
  161.                         CASE TRMS_CLOSEWINDOW
  162.                                    close_me := quitRequest(app)
  163.                         CASE TRMS_ERROR
  164.                             WriteF('\s\n',Tr_GetErrorString(trmsg.trm_Data))
  165.                               CASE TRMS_ACTION
  166.                                   id := trmsg.trm_ID
  167.                                   ->WriteF('User pressed button \d ',id)
  168.                             SELECT id
  169.                                 CASE 2
  170.                                     ->WriteF(', requester popping up...\n')
  171.                                     askRequest(app)
  172.                                 CASE 3
  173.                                     ->WriteF(', filerequester popping up...\n')
  174.                                     IF openreqtools()
  175.                                         filerequest('Pick a file',file)
  176.                                         ->WriteF('User picked file <\s>\n',file)
  177.                                                   Tr_SetAttribute(project,4,0,file)
  178.                                         closereqtools()
  179.                                     ENDIF
  180.                                 CASE 6
  181.                                     Tr_LockProject(project)
  182.                                     doProgress(app)
  183.                                     Tr_UnlockProject(project)
  184.                                         CASE 7
  185.                                     Tr_LockProject(project)
  186.                                     doListView(app)
  187.                                     Tr_UnlockProject(project)
  188.                             ENDSELECT
  189.                               CASE TRMS_NEWVALUE
  190.                             id := trmsg.trm_ID
  191.                                    SELECT id
  192.                                         CASE 1
  193.                                             data := Tr_GetAttribute(project, id, 0)
  194.                                             ->WriteF(', The chosen entry is \d\n',data)
  195.                                 CASE 4
  196.                                              data := Tr_GetAttribute(project, id, 0)
  197.                                              ->WriteF(', the string entered = <\s>\n',data)
  198.                             ENDSELECT
  199.                     ENDSELECT
  200.                 ENDIF
  201.                 Tr_ReplyMsg(trmsg)
  202.             ENDIF
  203.         ENDWHILE
  204.         Tr_CloseProject(project)
  205.      ELSE
  206.         DisplayBeep(NIL)
  207.      ENDIF
  208. ENDPROC
  209. /*--------------------------------------------------------------------------*/
  210. PROC doListView(app)
  211.     DEF    trmsg:PTR TO tr_Message,
  212.         close_me,
  213.          subproject,class,id
  214.  
  215.     IF (subproject:=Tr_OpenProject(app,
  216.         [WindowTitle('ListView'), WindowPosition(TRWP_CENTERDISPLAY), WindowID(2),
  217.           HorizGroupA,
  218.             Space,
  219.             VertGroupA,
  220.               Space,
  221.                 NamedFrameBox('ListView gadget'),
  222.               VertGroupA,
  223.                 Space,
  224.                 HorizGroupA,
  225.                   Space,
  226.                   ListSS(llist,1,0,0),
  227.                     Space,
  228.                   EndGroup,
  229.                   SpaceS,
  230.                   HorizGroupA,
  231.                       Space,
  232.                       Button('  Add  ',2),
  233.                       Space,
  234.                       Button('Delete ',3),
  235.                       Space,
  236.                   EndGroup,
  237.                   Space,
  238.                     HorizGroupA,
  239.                          Space,
  240.                       StringGadgetM('testing',4,240),
  241.                       Space,
  242.                   EndGroup,
  243.                   Space,
  244.                 EndGroup,
  245.                 Space,
  246.               EndGroup,
  247.               Space,
  248.             EndGroup,
  249.           EndProject]))
  250.  
  251.         close_me := FALSE
  252.         WHILE close_me=FALSE
  253.             Tr_Wait(app,NIL)
  254.             IF (trmsg:=Tr_GetMsg(app))
  255.                 IF (trmsg.trm_Project=subproject)
  256.                     class := trmsg.trm_Class
  257.                     id := trmsg.trm_ID
  258.                     ->WriteF('class= \h, id= \d, data= \d, code= \d \n',class,id,trmsg.trm_Data,trmsg.trm_Code)
  259.                     SELECT class
  260.                         CASE TRMS_CLOSEWINDOW
  261.                                  ->WriteF('User closed ListView Window\n')
  262.                             close_me := TRUE    /* don't bother to ask for confirmation this time */
  263.                         CASE TRMS_ERROR
  264.                             WriteF('\s\n',Tr_GetErrorString(trmsg.trm_Data))
  265.                         CASE TRMS_ACTION
  266.                             ->WriteF('User pressed button \d ',id)
  267.                             SELECT id
  268.                                 CASE 2
  269.                                      addToList(subproject,1,Tr_GetAttribute(subproject,4,0))
  270.                                  CASE 3
  271.                                              deleteFromList(subproject,1,Tr_GetAttribute(subproject,1,TRAT_Value))
  272.                             ENDSELECT
  273.                               CASE TRMS_NEWVALUE
  274.                             ->WriteF('New value for ID \d \n',id)
  275.                                    SELECT id
  276.                                         CASE 1
  277.                                     Tr_SetAttribute(subproject,4,0,getNodeName(llist,Tr_GetAttribute(subproject,1,TRAT_Value)))
  278.                             ENDSELECT
  279.                     ENDSELECT
  280.                    ENDIF
  281.                 Tr_ReplyMsg(trmsg)
  282.             ENDIF
  283.          ENDWHILE
  284.         Tr_CloseProject(subproject)
  285.     ELSE
  286.         DisplayBeep(NIL)
  287.     ENDIF
  288.  
  289. ENDPROC
  290. /*---------------------------- progress demo -------------------------------*/
  291. PROC doProgress(app)
  292.     DEF    done,slowcount,
  293.          trmsg:PTR TO tr_Message,
  294.          subproject,class,id
  295.  
  296.     IF (subproject:=Tr_OpenProject(app,
  297.         [WindowTitle('Progress'), WindowPosition(TRWP_CENTERDISPLAY), WindowID(2),
  298.           HorizGroupA,
  299.             Space,
  300.             VertGroupA,
  301.               Space,
  302.                 NamedFrameBox('Progress indicator counting from 0 to 1000'),
  303.               VertGroupA,
  304.                 Space,
  305.                 HorizGroupA,
  306.                   Space,
  307.                   Progress(1000,0,1),
  308.                   Space,
  309.                   EndGroup,
  310.                   Space,
  311.                 VertGroupA,
  312.                   Space,
  313.                   HorizGroupA,
  314.                     Space,
  315.                       Button('Abort',2),
  316.                       Space,
  317.                       Button('Restart',3),
  318.                     Space,
  319.                     EndGroup,
  320.                     Space,
  321.                   EndGroup,
  322.               EndGroup,
  323.               Space,
  324.               EndGroup,
  325.               Space,
  326.             EndGroup,
  327.         EndProject]))
  328.  
  329.         done := FALSE
  330.         slowcount := 0
  331.         WHILE done=FALSE
  332.             IF (trmsg:=Tr_GetMsg(app))
  333.                 IF (trmsg.trm_Project=subproject)
  334.                     class := trmsg.trm_Class
  335.                     SELECT class
  336.                         CASE TRMS_CLOSEWINDOW
  337.                                    ->WriteF('clicked closewindow\n')
  338.                             done := Tr_EasyRequest(app, '%3Abort the action?','Yes|No',NIL)
  339.                         CASE TRMS_ERROR
  340.                             ->WriteF('\s',Tr_GetErrorString(trmsg.trm_Data))
  341.                               CASE TRMS_ACTION
  342.                                   id := trmsg.trm_ID
  343.                                   ->WriteF('ID of gadget = \d\n',id)
  344.                                    SELECT id
  345.                                        CASE 2
  346.                                     done := Tr_EasyRequest(app, '%3Abort the action?','Yes|No',NIL)
  347.                                         CASE 3
  348.                                              slowcount := 0
  349.                                    ENDSELECT
  350.                     ENDSELECT
  351.                    ENDIF
  352.                 Tr_ReplyMsg(trmsg)
  353.             ENDIF
  354.                Tr_SetAttribute(subproject,1,TRAT_Value,slowcount)
  355.  
  356.                /* Normally, you would put your action here */
  357.  
  358.             INC slowcount
  359.             IF slowcount>=1000 THEN done := TRUE
  360.         ENDWHILE
  361.         Tr_CloseProject(subproject)
  362.     ELSE
  363.         DisplayBeep(NIL)
  364.     ENDIF
  365. ENDPROC
  366. /*--------------------------- a simple request -----------------------------*/
  367. PROC askRequest(app)
  368.      DEF answer
  369.      answer := Tr_EasyRequest(app, 'This is an EasyRequester\n%3This should be 3D-text\n%bThis is bold text\n%hThis is highlighted text',
  370.             'OK|Dummy option...|Another dummy option|Cancel',NIL)
  371.      ->WriteF('\nUser selected button \d in the requester\n\n',answer)
  372. ENDPROC
  373. /*--------------------------- quitting request -----------------------------*/
  374. PROC quitRequest(app) IS Tr_EasyRequest(app, '%3Do you really want to QUIT?','Yes|No',NIL)
  375. /*---------------------------- reqtools opening / closing ------------------*/
  376. PROC openreqtools()
  377.     IF reqtoolsbase:=OpenLibrary('reqtools.library',37)
  378.         RETURN TRUE
  379.     ELSE
  380.         WriteF('Could not open reqtools.library!\n')
  381.         CleanUp(0)
  382.     ENDIF
  383. ENDPROC
  384.  
  385. PROC closereqtools()
  386.     IF reqtoolsbase THEN CloseLibrary(reqtoolsbase)
  387. ENDPROC
  388. /*--------------------------- reqtools filerequester -----------------------*/
  389. PROC filerequest(title,returnvalue)
  390.     DEF filename[120]:STRING,test[2]:STRING,dir,req
  391.     returnvalue[0]:=0
  392.     IF reqtoolsbase
  393.         IF req:=RtAllocRequestA(0,0)
  394.             filename[0]:=0
  395.             test[0]:=0
  396.             IF RtFileRequestA(req,filename,title,0)
  397.                 MOVE.L req,A0
  398.                 MOVE.L 16(A0),dir
  399.                 StrCopy(returnvalue,dir,ALL)        /* get the path */
  400.  
  401.                 RightStr(test,returnvalue,1)
  402.                     IF StrCmp(test,'/',1)=FALSE AND StrCmp(test,':',1)=FALSE AND StrLen(dir)>0
  403.                     StrAdd(returnvalue,'/',1);    /* add slash if necessary */
  404.                 ENDIF
  405.  
  406.                 StrAdd(returnvalue,filename,ALL)   /* add the filename */
  407.             ENDIF
  408.             RtFreeRequest(req)
  409.         ENDIF
  410.     ELSE
  411.         WriteF('error: reqtools.library not opened\n');
  412.         RETURN FALSE
  413.      ENDIF
  414. ENDPROC returnvalue
  415. /*--------------------------------------------------------------------------*/
  416. PROC initList(l:PTR TO mlh)    -> Initialize an exec list
  417.     l.head:=l+4
  418.     l.tail:=NIL
  419.     l.tailpred:=l
  420. ENDPROC
  421.  
  422. PROC addToList(project,id,content)
  423.     DEF newNode=NIL:PTR TO ln, node:PTR TO ln,len,
  424.         done=FALSE,itemPosition=0
  425.  
  426.     IF (len:=StrLen(content))=0 THEN RETURN    -> Don't add if there's nothing to add.
  427.  
  428.     NEW newNode                        -> Create a node and a string to add to the listview.
  429.     newNode.name:=String(len)
  430.     StrCopy(newNode.name, content, ALL)
  431.  
  432.     Tr_SetAttribute(project,id,0,NIL)        -> Detach the exec list from the listview gadget.
  433.  
  434.     -> Decide where to insert the new item.  Sorted on first character, for example
  435. /*
  436.     node:=llist.head
  437.     IF llist.tailpred=llist
  438.         AddHead(llist, newNode)
  439.     ELSEIF Char(node.name)>content[]
  440.         AddHead(llist, newNode)
  441.     ELSEIF node=llist.tailpred
  442.         AddTail(llist, newNode)
  443.     ELSE
  444.         WHILE done=FALSE
  445.             node:=node.succ
  446.             INC itemPosition
  447.             IF Char(node.name)>content[]
  448.                 done:=TRUE
  449.             ELSEIF node.succ=NIL
  450.                 done:=TRUE
  451.             ENDIF
  452.         ENDWHILE
  453.         Insert(llist, newNode, node.pred)
  454.     ENDIF
  455. */
  456.  
  457. ->    Or, simply at the end OF the LIST, which is more natural.
  458.     node:=llist.head
  459.     IF llist.tailpred=llist
  460.         AddHead(llist, newNode)
  461.     ELSEIF node=llist.tailpred
  462.         AddTail(llist, newNode)
  463.     ELSE
  464.         WHILE done=FALSE                -> hunt for last item in the list
  465.             node:=node.succ
  466.             INC itemPosition
  467.             IF node.succ=NIL
  468.                 done:=TRUE            -> ah, found it...
  469.             ENDIF
  470.         ENDWHILE
  471.         Insert(llist, newNode, node.pred)
  472.     ENDIF
  473.  
  474.     Tr_SetAttribute(project,id,0,llist)    ->    Reattach the exec list to the listview gadget.
  475. ENDPROC
  476.  
  477. PROC deleteFromList(project,id,itemPosition)
  478.     DEF node:PTR TO ln, i
  479.     IF (itemPosition=-1) OR (llist.tailpred=llist) THEN RETURN     -> Don't delete if no item is selected.
  480.     Tr_SetAttribute(project,id,0,NIL)        -> Detach the exec list from the listview gadget.
  481.     node:=llist.head                    -> Find the node that corresponds to itemPosition in the exec list.
  482.     i := 1
  483.     WHILE (i<=itemPosition) AND (node<>llist.tailpred) AND (node.succ<>NIL)
  484.         node := node.succ
  485.         INC i
  486.     ENDWHILE
  487.  
  488.     Remove(node)                        -> Remove and deallocate the node's data
  489.     Dispose(node.name)
  490.     Dispose(node)
  491.     Tr_SetAttribute(project,id,0,llist)    -> Reattach the exec list to the listview gadget.
  492. ENDPROC
  493.  
  494. PROC getNodeName(lst:PTR TO mlh,itemPosition) -> return a stringptr, from an index (itemPosition) in a linked list (lst)
  495.     DEF node:PTR TO ln, i
  496.     node:=lst.head
  497.     i := 1                -> note: this is safer than the FOR..ENDFOR B.Wills originally used.
  498.     WHILE (i<=itemPosition) AND (node<>lst.tailpred) AND (node.succ<>NIL)
  499.         node := node.succ
  500.         INC i
  501.     ENDWHILE
  502. ENDPROC node.name
  503.  
  504. /*----------------------------- end of source ------------------------------*/
  505.